Attribute VB_Name = "Module3"
Sub addRecords()
Dim x As Integer
Dim rowsCount As Integer
rowsCount = 0
x = Columns("CT").Column
Dim ilastrow As Long, i As Long, rRange As Range, sh As Worksheet
Set sh = ActiveSheet
ilastrow = sh.Cells(Rows.Count, 1).End(xlUp).Row
For i = 3 To ilastrow
    If sh.Cells(i, 1) <> "" And sh.Cells(i, 1) <> "somma" And sh.Cells(i, 1) <> "Operatori" Then
       If Len(sh.Cells(i, x)) > 0 Then
            rowsCount = rowsCount + 1
            If rRange Is Nothing Then
                
                Set rRange = sh.Range(sh.Cells(i, 1), sh.Cells(i, 1))
                Set rRange = Union(rRange, sh.Range(sh.Cells(i, x - 3), sh.Cells(i, x + 1)))
            Else
                Set rRange = Union(rRange, sh.Range(sh.Cells(i, 1), sh.Cells(i, 1)))
                Set rRange = Union(rRange, sh.Range(sh.Cells(i, x - 3), sh.Cells(i, x + 1)))
            End If
       End If
    End If
Next i
If rRange Is Nothing Then
    MsgBox ("Non trovo i record")
Else
    rRange.Select
    Dim TmpName As String
    On Error Resume Next
    Application.DisplayAlerts = False
    TmpName = ActiveSheet.Name & "(Tmp)"
    Sheets(TmpName).Delete
    Selection.Copy
    
    NewFN = Application.GetOpenFilename(FileFilter:="Excel Files (*.xlsx;*.xls), *.xlsx;*.xls", Title:="Please select a file")
    Set wb = Workbooks.Open(NewFN)
    wbLastrow = wb.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    
    
    With wb.ActiveSheet
            .Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    End With
    
    For i = wbLastrow + 1 To wbLastrow + rowsCount
        wb.ActiveSheet.Cells(i, 7) = Right(sh.Cells(1, 2), Len(sh.Cells(1, 2)) - InStr(sh.Cells(1, 2), "-"))
    Next i
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    wb.Close
End If



End Sub

